En la base de datos relacionada, se encuentra el “Registro de Eventos Naturales o Antrópicos no Intencionales”ocurridos durante el año 2019, que fueron reportados a la UNGRD (Unidad Nacional para la Gestión del Riesgo de Desastres) con su respectiva afectación y atención prestada a cada uno. https://www.datos.gov.co/Ambiente-y-Desarrollo-Sostenible/Emergencias-UNGRD-2019/4fd8-ptcr (BaseExcelDepurada)
head(Incendios)
## # A tibble: 6 x 75
## FECHA DEPARTAMENTO COD_DANE MUNICIPIO EVENTO_INC EVENTO DIVIPOLA FALLECIDOS
## <chr> <chr> <chr> <chr> <dbl> <chr> <dbl> <dbl>
## 1 01/01/2~ ANTIOQUIA 05 SAN JERO~ 0 INCEN~ 5656 0
## 2 01/01/2~ RISARALDA 66 MARSELLA 0 INMER~ 66440 1
## 3 01/01/2~ ANTIOQUIA 05 ANZA 1 INCEN~ 5044 0
## 4 01/01/2~ ANTIOQUIA 05 MONTEBEL~ 1 INCEN~ 5467 0
## 5 01/01/2~ ANTIOQUIA 05 CAUCASIA 0 INCEN~ 5154 0
## 6 01/01/2~ ANTIOQUIA 05 AMAGA 1 INCEN~ 5030 0
## # ... with 67 more variables: HERIDOS <dbl>, DESAPARECIDOS <dbl>,
## # PERSONAS <dbl>, FAMILIAS <dbl>, `VIVIENDAS DESTRUIDAS` <dbl>,
## # `VIVIENDAS AVERIADAS` <dbl>, VIAS <dbl>, `PUENTES VEHICULARES` <dbl>,
## # `PUENTES PEATONALES` <dbl>, ACUEDUCTO <dbl>, ALCANTARILLADO <dbl>,
## # `CENTROS DE SALUD` <dbl>, `CENTROS EDUCATIVOS` <dbl>,
## # `CENTROS COMUNITARIOS` <dbl>, HECTAREAS <dbl>, `OTROS-AFECTACION` <chr>,
## # `SUBSIDIO DE ARRIENDO` <dbl>, `ASISTENCIA NO ALIMENTARIA` <dbl>, ...
## En el proceso de limpieza se quitaros 2 registros , un dato que corresponde a peru y un dato vacio
dim(Incendios)
## [1] 4435 75
N = nrow(Incendios)
## N corresponde a la población total del estudio que son el total de registros
z = qnorm(0.035, mean= 0, sd = 1, lower.tail = TRUE)
##
d = 0.03
n = z*z*0.5*0.5/(d*d+(z*z*0.5*0.5)/N)
n = ceiling(n)
n
## [1] 757
set.seed(3564)
muestra_inc <- Incendios [ sample (N, size = n ),]
#muestra_inc
MediaH=mean(muestra_inc$HERIDOS)
MediaH
## [1] 0.3949802
MediaF=mean(muestra_inc$FALLECIDOS)
MediaF
## [1] 0.1294584
muestra_inc$TotalN <- N
head(muestra_inc)
## # A tibble: 6 x 76
## FECHA DEPARTAMENTO COD_DANE MUNICIPIO EVENTO_INC EVENTO DIVIPOLA FALLECIDOS
## <chr> <chr> <chr> <chr> <dbl> <chr> <dbl> <dbl>
## 1 05/30/2~ RISARALDA 66 DOSQUEBR~ 0 MOVIM~ 66170 0
## 2 04/20/2~ NORTE DE SA~ 54 TOLEDO 0 AVENI~ 54820 0
## 3 07/29/2~ SANTANDER 68 RIONEGRO 0 VENDA~ 68615 0
## 4 01/11/2~ META 50 GRANADA 1 INCEN~ 50313 0
## 5 01/27/2~ BOYACA 15 RAMIRIQUI 1 INCEN~ 15599 0
## 6 09/13/2~ TOLIMA 73 COYAIMA 1 INCEN~ 73217 0
## # ... with 68 more variables: HERIDOS <dbl>, DESAPARECIDOS <dbl>,
## # PERSONAS <dbl>, FAMILIAS <dbl>, `VIVIENDAS DESTRUIDAS` <dbl>,
## # `VIVIENDAS AVERIADAS` <dbl>, VIAS <dbl>, `PUENTES VEHICULARES` <dbl>,
## # `PUENTES PEATONALES` <dbl>, ACUEDUCTO <dbl>, ALCANTARILLADO <dbl>,
## # `CENTROS DE SALUD` <dbl>, `CENTROS EDUCATIVOS` <dbl>,
## # `CENTROS COMUNITARIOS` <dbl>, HECTAREAS <dbl>, `OTROS-AFECTACION` <chr>,
## # `SUBSIDIO DE ARRIENDO` <dbl>, `ASISTENCIA NO ALIMENTARIA` <dbl>, ...
#muestra_inc
mydesign <- svydesign(id = ~1, data = muestra_inc, fpc = ~TotalN)
summary(mydesign)
## Independent Sampling design
## svydesign(id = ~1, data = muestra_inc, fpc = ~TotalN)
## Probabilities:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1707 0.1707 0.1707 0.1707 0.1707 0.1707
## Population size (PSUs): 4435
## Data variables:
## [1] "FECHA"
## [2] "DEPARTAMENTO"
## [3] "COD_DANE"
## [4] "MUNICIPIO"
## [5] "EVENTO_INC"
## [6] "EVENTO"
## [7] "DIVIPOLA"
## [8] "FALLECIDOS"
## [9] "HERIDOS"
## [10] "DESAPARECIDOS"
## [11] "PERSONAS"
## [12] "FAMILIAS"
## [13] "VIVIENDAS DESTRUIDAS"
## [14] "VIVIENDAS AVERIADAS"
## [15] "VIAS"
## [16] "PUENTES VEHICULARES"
## [17] "PUENTES PEATONALES"
## [18] "ACUEDUCTO"
## [19] "ALCANTARILLADO"
## [20] "CENTROS DE SALUD"
## [21] "CENTROS EDUCATIVOS"
## [22] "CENTROS COMUNITARIOS"
## [23] "HECTAREAS"
## [24] "OTROS-AFECTACION"
## [25] "SUBSIDIO DE ARRIENDO"
## [26] "ASISTENCIA NO ALIMENTARIA"
## [27] "APOYO ALIMENTARIO"
## [28] "MATERIALES CONSTRUCCION"
## [29] "SACOS - BIGBAG"
## [30] "OBRAS DE EMERGENCIA"
## [31] "CARROTANQUES - MOTOBOMBAS-PLANTA POTABILIZADORA"
## [32] "HORAS MAQUINA\r\nRETROEXCAVADORA\r\nBULLDOCER\r\nINTERVENTORIA"
## [33] "APOYO AEREO / TERRESTRE"
## [34] "FIC / TRANSFERENCIAS ECONOMICAS"
## [35] "INFRAESCTRUCTURA TECNOLOGICA"
## [36] "RECURSOS EJECUTADOS"
## [37] "OTROS"
## [38] "CANTIDAD KIT DE ALIMENTO"
## [39] "VALOR KIT DE ALIMENTO"
## [40] "CANTIDAD RACIONES DE CAMPAÑA"
## [41] "VALOR RACIONES DE CAMPAÑA"
## [42] "CANTIDAD KIT ASEO"
## [43] "VALOR KIT ASEO"
## [44] "CANTIDAD KIT COCINA"
## [45] "VALOR KIT COCINA"
## [46] "CANTIDAD COLCHONETA"
## [47] "VALOR COLCHONETA"
## [48] "CANTIDAD FRAZADAS/\r\nSOBRECAMAS"
## [49] "VALOR FRAZADAS/\r\nSOBRECAMAS"
## [50] "CANTIDAD SABANAS / COBIJA SENCILLA"
## [51] "VALOR SABANAS / COBIJA SENCILLA"
## [52] "CANTIDAD HAMACAS"
## [53] "VALOR HAMACAS"
## [54] "CANTIDAD TOLDILLOS"
## [55] "VALOR TOLDILLOS"
## [56] "CANTIDAD CARPAS"
## [57] "VALOR CARPAS"
## [58] "CANTIDAD ESTUFAS"
## [59] "VALOR ESTUFAS"
## [60] "VALOR TOTAL ASISTENCIA NO ALIMENTARIA"
## [61] "CANTIDAD PLASTICO NEGRO"
## [62] "VALOR PLASTICO NEGRO"
## [63] "CANTIDAD SACOS"
## [64] "VALOR SACOS"
## [65] "CANTIDAD BIG BAG"
## [66] "VALOR BIG BAG"
## [67] "CANTIDAD CEMENTO"
## [68] "VALOR CEMENTO"
## [69] "CANTIDAD TEJAS DE ZINC"
## [70] "VALOR TEJAS DE ZINC"
## [71] "CANTIDAD TEJAS DE FIBROCEMENTO"
## [72] "VALOR TEJAS DE FIBROCEMENTO"
## [73] "DESCRIPCION MATERIALES DE CONSTRUCCION"
## [74] "VALOR MATERIALES DE CONSTRUCCION"
## [75] "VALOR TOTAL APOYO DEL FNGRD"
## [76] "TotalN"
# Estimaciones
svymean(muestra_inc$HERIDOS,mydesign)
## mean SE
## [1,] 0.39498 0.0662
summary(mydesign)
## Independent Sampling design
## svydesign(id = ~1, data = muestra_inc, fpc = ~TotalN)
## Probabilities:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1707 0.1707 0.1707 0.1707 0.1707 0.1707
## Population size (PSUs): 4435
## Data variables:
## [1] "FECHA"
## [2] "DEPARTAMENTO"
## [3] "COD_DANE"
## [4] "MUNICIPIO"
## [5] "EVENTO_INC"
## [6] "EVENTO"
## [7] "DIVIPOLA"
## [8] "FALLECIDOS"
## [9] "HERIDOS"
## [10] "DESAPARECIDOS"
## [11] "PERSONAS"
## [12] "FAMILIAS"
## [13] "VIVIENDAS DESTRUIDAS"
## [14] "VIVIENDAS AVERIADAS"
## [15] "VIAS"
## [16] "PUENTES VEHICULARES"
## [17] "PUENTES PEATONALES"
## [18] "ACUEDUCTO"
## [19] "ALCANTARILLADO"
## [20] "CENTROS DE SALUD"
## [21] "CENTROS EDUCATIVOS"
## [22] "CENTROS COMUNITARIOS"
## [23] "HECTAREAS"
## [24] "OTROS-AFECTACION"
## [25] "SUBSIDIO DE ARRIENDO"
## [26] "ASISTENCIA NO ALIMENTARIA"
## [27] "APOYO ALIMENTARIO"
## [28] "MATERIALES CONSTRUCCION"
## [29] "SACOS - BIGBAG"
## [30] "OBRAS DE EMERGENCIA"
## [31] "CARROTANQUES - MOTOBOMBAS-PLANTA POTABILIZADORA"
## [32] "HORAS MAQUINA\r\nRETROEXCAVADORA\r\nBULLDOCER\r\nINTERVENTORIA"
## [33] "APOYO AEREO / TERRESTRE"
## [34] "FIC / TRANSFERENCIAS ECONOMICAS"
## [35] "INFRAESCTRUCTURA TECNOLOGICA"
## [36] "RECURSOS EJECUTADOS"
## [37] "OTROS"
## [38] "CANTIDAD KIT DE ALIMENTO"
## [39] "VALOR KIT DE ALIMENTO"
## [40] "CANTIDAD RACIONES DE CAMPAÑA"
## [41] "VALOR RACIONES DE CAMPAÑA"
## [42] "CANTIDAD KIT ASEO"
## [43] "VALOR KIT ASEO"
## [44] "CANTIDAD KIT COCINA"
## [45] "VALOR KIT COCINA"
## [46] "CANTIDAD COLCHONETA"
## [47] "VALOR COLCHONETA"
## [48] "CANTIDAD FRAZADAS/\r\nSOBRECAMAS"
## [49] "VALOR FRAZADAS/\r\nSOBRECAMAS"
## [50] "CANTIDAD SABANAS / COBIJA SENCILLA"
## [51] "VALOR SABANAS / COBIJA SENCILLA"
## [52] "CANTIDAD HAMACAS"
## [53] "VALOR HAMACAS"
## [54] "CANTIDAD TOLDILLOS"
## [55] "VALOR TOLDILLOS"
## [56] "CANTIDAD CARPAS"
## [57] "VALOR CARPAS"
## [58] "CANTIDAD ESTUFAS"
## [59] "VALOR ESTUFAS"
## [60] "VALOR TOTAL ASISTENCIA NO ALIMENTARIA"
## [61] "CANTIDAD PLASTICO NEGRO"
## [62] "VALOR PLASTICO NEGRO"
## [63] "CANTIDAD SACOS"
## [64] "VALOR SACOS"
## [65] "CANTIDAD BIG BAG"
## [66] "VALOR BIG BAG"
## [67] "CANTIDAD CEMENTO"
## [68] "VALOR CEMENTO"
## [69] "CANTIDAD TEJAS DE ZINC"
## [70] "VALOR TEJAS DE ZINC"
## [71] "CANTIDAD TEJAS DE FIBROCEMENTO"
## [72] "VALOR TEJAS DE FIBROCEMENTO"
## [73] "DESCRIPCION MATERIALES DE CONSTRUCCION"
## [74] "VALOR MATERIALES DE CONSTRUCCION"
## [75] "VALOR TOTAL APOYO DEL FNGRD"
## [76] "TotalN"
#=========================
VarH=var(muestra_inc$HERIDOS)
VarH
## [1] 3.998546
MediaH=mean(muestra_inc$HERIDOS)
MediaH
## [1] 0.3949802
VarEstim=(1-757/4435)*VarH/757
VarEstim
## [1] 0.004380507
EE=sqrt(VarEstim)
EE
## [1] 0.0661854
CV=(EE/MediaH)*100
CV
## [1] 16.75664
valort=qt(c(0.025),df=(757-1),lower.tail = FALSE)# probabilidad de cola 0.025 equivle a nivel de confianza del 95%, ya q la dist t es simetrica
Lsup=MediaH+(valort*EE)
Linf=MediaH-(valort*EE)
resumenMediaH1 <- data.frame(n ,MediaH,VarEstim,EE,Linf,Lsup,CV)
resumenMediaH1
## n MediaH VarEstim EE Linf Lsup CV
## 1 757 0.3949802 0.004380507 0.0661854 0.2650512 0.5249092 16.75664
#Con un nivel de confianza del 95% el promedio de los heridos de la población va a ser de 0.39
EstimTot=N*MediaF
EstimTot
## [1] 574.148
VarEstimTOT=(N^2)*VarEstim
VarEstimTOT
## [1] 86161.17
#El Error Estándar (EE) de la estimación, es:
EETot=sqrt(VarEstimTOT)
EETot
## [1] 293.5322
## Calculo de intervalo de confianza al 95%
valortF=qt(c(0.025),df=(757-1),lower.tail = FALSE)# probabilidad de cola 0.025 equivle a nivel de confianza del 95%, ya q la dist t es simetrica
LsupTotF=EstimTot+(valortF*EETot)
LinfTotF=EstimTot-(valortF*EETot)
# El coeficiente de variación de la estimación del Total, es:
CVTot=(EETot/EstimTot)*100
CVTot
## [1] 51.12484
resumenTotF <- data.frame(n ,EstimTot,VarEstimTOT,EETot,LinfTotF,LsupTotF,CVTot)
resumenTotF
## n EstimTot VarEstimTOT EETot LinfTotF LsupTotF CVTot
## 1 757 574.148 86161.17 293.5322 -2.08718 1150.383 51.12484
## Cartografía
sp_df <- readOGR(dsn = "MGN2021_DPTO_POLITICO", layer = "MGN_DPTO_POLITICO")
## Warning in OGRSpatialRef(dsn, layer, morphFromESRI = morphFromESRI, dumpSRS =
## dumpSRS, : Discarded datum Marco_Geocentrico_Nacional_de_Referencia in Proj4
## definition: +proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs
## OGR data source with driver: ESRI Shapefile
## Source: "D:\Scripts_SQL\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO", layer: "MGN_DPTO_POLITICO"
## with 33 features
## It has 9 fields
#head(sp_df)
#fix(sp_df)
#as.data.frame(sp_df)
DPTO_SH="MGN2021_DPTO_POLITICO/MGN_DPTO_POLITICO.shp"
DPTO_SH2 <- st_read(DPTO_SH)
## Reading layer `MGN_DPTO_POLITICO' from data source
## `D:\Scripts_SQL\ProyectoEstadistica\ProyectoEstadistica\TallerMuestreo\MGN2021_DPTO_POLITICO\MGN_DPTO_POLITICO.shp'
## using driver `ESRI Shapefile'
## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS: MAGNA-SIRGAS
HeridosDepto <- muestra_inc %>%
group_by(DEPARTAMENTO) %>%
summarise(promedioH = mean(HERIDOS),COD_DANE)
## `summarise()` has grouped output by 'DEPARTAMENTO'. You can override using the
## `.groups` argument.
# Para visualizar la base resumida
ResumenH=as.data.frame(HeridosDepto)
#ResumenH
Etiquetas=unite(ResumenH, Etiqueta,c(1,2), sep = ": ", remove = TRUE)
Etiquetas=Etiquetas[,1]
#Etiquetas
Resumen3=cbind(ResumenH, Etiquetas )
#Resumen3
DPTO_SH2
## Simple feature collection with 33 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -81.73562 ymin: -4.229406 xmax: -66.84722 ymax: 13.39473
## Geodetic CRS: MAGNA-SIRGAS
## First 10 features:
## DPTO_CCDGO DPTO_CNMBR DPTO_ANO_C DPTO_ACT_A
## 1 05 ANTIOQUIA 1886 Constitucion Politica de 1886
## 2 08 ATLÁNTICO 1910 Ley 21 de 1910
## 3 11 BOGOTÁ, D.C. 1538 Constitucion Politica de 1886
## 4 13 BOLÍVAR 1886 Constitucion Politica de 1886
## 5 15 BOYACÁ 1886 Constitucion Politica de 1886
## 6 17 CALDAS 1905 11 de Abril de 1905
## 7 18 CAQUETÁ 1981 Ley 78 del 29 de Diciembre de 1981
## 8 19 CAUCA 1857 15 de junio de 1857
## 9 20 CESAR 1967 Ley 25 21 de junio de 1967
## 10 23 CÓRDOBA 1951 Ley 9 del 18 de Diciembre de 1951
## DPTO_NAREA DPTO_CSMBL DPTO_VGNC Shape_Leng Shape_Area
## 1 62808.630 3 2021 21.492374 5.1352363
## 2 3314.447 3 2021 2.573162 0.2738225
## 3 1622.853 3 2021 3.765324 0.1322079
## 4 26719.968 3 2021 16.233072 2.1956393
## 5 23138.048 3 2021 15.906491 1.8883908
## 6 7425.246 3 2021 6.663759 0.6054998
## 7 92831.284 3 2021 21.218741 7.5402411
## 8 31242.803 3 2021 13.955090 2.5344101
## 9 22565.307 3 2021 12.578459 1.8582044
## 10 25086.221 3 2021 9.725656 2.0575064
## geometry
## 1 MULTIPOLYGON (((-76.41355 8...
## 2 MULTIPOLYGON (((-74.84946 1...
## 3 MULTIPOLYGON (((-74.07059 4...
## 4 MULTIPOLYGON (((-76.17318 9...
## 5 MULTIPOLYGON (((-72.17368 7...
## 6 MULTIPOLYGON (((-74.67154 5...
## 7 MULTIPOLYGON (((-74.79916 2...
## 8 MULTIPOLYGON (((-76.45922 3...
## 9 MULTIPOLYGON (((-73.45335 1...
## 10 MULTIPOLYGON (((-75.88119 9...
DPTO_JOIN <- geo_join(DPTO_SH2, Resumen3,"DPTO_CCDGO", "COD_DANE")
## Warning: We recommend using the dplyr::*_join() family of functions instead.
## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
#DPTO_JOIN = as.data.frame(DPTO_JOIN)
#DPTO_JOIN
pal <- colorNumeric( palette = "RdYlBu", domain=DPTO_JOIN$promedioH) #palette = "YlGnBu" "RdBu" "RdYlBu" "Spectral" "Paired" "PuRd" "RdYlGn"
popup_sb <- paste0("Promedio de Heridos: ", as.character(DPTO_JOIN$promedioH))
leaflet(sp_df) %>%
addProviderTiles("CartoDB.Positron") %>%
#setView(-98.483330, 38.712046, zoom = 4) %>%
addPolygons(data = DPTO_JOIN ,
fillColor = ~pal(DPTO_JOIN$promedioH),
opacity = 1,
color = "black",
dashArray = "3",fillOpacity = 0.9,
highlight = highlightOptions(
weight = 1,
color = "#666",
dashArray = "",
fillOpacity = 1,
bringToFront = TRUE),
label = DPTO_JOIN$Etiquetas,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend(pal = pal, values =DPTO_JOIN$promedioH, opacity = 0.7, title = NULL,
position = "bottomright")
## Warning: sf layer has inconsistent datum (+proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs).
## Need '+proj=longlat +datum=WGS84'